;;;; Copyright 2009 Peter von Etter

;;;; This file is part of Autoproject

;;;; Autoproject is free software: you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation, either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; Autoproject is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with Autoproject.  If not, see
;;;; <http://www.gnu.org/licenses/>.

(in-package :autoproject)

(labels ((make-save-core-form (core-name)
           `(save-lisp-and-die ,core-name))
         
         (shell-commands (commands)
           (if (listp commands)
               (format nil "~{        ~A~%~}" commands)
               (format nil "        ~A~%" commands))))
       
  (let ((here *load-truename*))

    (defun make-autoasdf-shellscript ()
      (let* ((base-core-var "$BASE_CORE")
             (core-var "$CORE")
             (op-var "$1")
             (system-name "$2") 

             (available-ops
              (list "build" "rebuild" "build-inc" "rebuild-inc"
                    "baseless" "base-core" "core" "clean" "run" "slime"))

             (usage (format nil "Usage: $0 OPERATION SYSTEM

Supported operations:~{ ~A~}
" available-ops))
             
             (base-core-name (format nil "~A.base.core" system-name))

             (core-name (format nil "~A.core" system-name))
             
             (script-pathname
              (merge-pathnames
               (make-pathname :name "autoasdf"
                              :directory (pathname-directory here))))                  
           
             (base-core-target
              (make-lisp-shell-command 
                :batch t
                :eval `((require ,*this-package*)
                        (load-asdf-system-dependencies ,system-name)
                        ,(make-save-core-form base-core-var))))
           
             (ensure-base-core-target
              (format nil "if [ ! -f \"~A\" ]; then ~A ; fi"
                      base-core-var
                      base-core-target))

             (core-target 
              (list
               ensure-base-core-target
               (make-lisp-shell-command 
                :core base-core-var
                :batch t
                :eval `((compile-asdf-system ,system-name)
                        ,(make-save-core-form core-var)))))

             (ensure-core-target
              (format nil "if [ ! -f \"~A\" ]; then ~A ; fi"
                      core-var
                      core-target))
             
             (build-target
              (list
               ensure-base-core-target
               (make-lisp-shell-command 
                :batch t
                :core base-core-var
                :eval `((compile-asdf-system ,system-name)
                        (quit)))))

             (build-no-base-target
              (make-lisp-shell-command 
               :batch t
               :eval `((require ,*this-package*)
                       (compile-asdf-system ,system-name)
                       (quit))))
             
             (rebuild-target
              (list
               ensure-base-core-target
               (make-lisp-shell-command 
                :batch t
                :core base-core-var
                :eval `((recompile-asdf-system ,system-name)
                        (quit)))))

             (build-incremental-target
              (make-lisp-shell-command 
                :batch t
                :eval `((require ,*this-package*)
                        (quit (compile-asdf-system-incrementally 
                               ,system-name)))))

             (rebuild-incremental-target
              (make-lisp-shell-command 
                :batch t
                :eval `((require ,*this-package*)
                        (quit (recompile-asdf-system-incrementally 
                               ,system-name)))))

             (clean-target
              (list
               (make-lisp-shell-command 
                ;; :core base-core-name
                :batch t
                :eval `((require ,*this-package*)
                        (asdf:oos 'asdfa:revert-op ,system-name)
                        (quit)))
               (format nil "rm ~A ~A"
                       base-core-var 
                       core-var))) 
             
             (slime-target
              (list
               ensure-base-core-target
               (make-lisp-shell-command 
                :core base-core-name
                :eval `((compile-asdf-system ,system-name)
                        (compile-asdf-system :swank)
                        (funcall (read-from-string "SWANK::CREATE-SERVER"))))))

             (run-target
              (list 
               ensure-core-target
               (make-lisp-shell-command 
                :core core-var)))
             
             (script-contents
              (format nil
                      "#!/bin/sh
# This file was auto-generated

if [ -z \"$1\" ] 
then 
    echo ~S
    exit 1
fi
 
BASE_CORE=~A
CORE=~A

case ~A in
    build)
~A
        ;;
    rebuild)
~A
        ;;
    build-inc)
~A
        ;;
    rebuild-inc)
~A
        ;;
    baseless)
~A
        ;;
    base-core)
~A
        ;;
    core)
~A
        ;;
    clean)
~A
        ;;
    run)
~A
        ;;
    slime)
~A
esac
"
                      usage
                      
                      ;; Vars
                      base-core-name
                      core-name
                      
                      op-var

                      ;; Build
                      (shell-commands build-target)
                      
                      ;; Rebuild
                      (shell-commands rebuild-target)

                      ;; Incremental build
                      (shell-commands build-incremental-target)

                      ;; Incremental rebuild
                      (shell-commands rebuild-incremental-target)

                      ;; Build no base
                      (shell-commands build-no-base-target)

                      ;; Base core
                      (shell-commands base-core-target)

                      ;; Core
                      (shell-commands core-target)
                    
                      ;; Clean
                      (shell-commands clean-target)

                      ;; Run
                      (shell-commands run-target)
                    
                      ;; Slime
                      (shell-commands slime-target))))
      
      
        (with-open-file (s script-pathname
                           :direction :output
                           :if-exists :supersede)
          (princ script-contents s))

        (asdf:run-shell-command 
         "chmod u+x ~S"
         (namestring script-pathname))))))


